Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology that seeks to develop and explore the department’s impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University.
By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.
This websites presents some of the project outcomes as interactive visualizations.
---
title: "ReAct // Data Analytics Dashboard"
output:
flexdashboard::flex_dashboard:
theme: bootstrap
vertical_layout: scroll
social: menu
source: embed
---
```{r setup, include=FALSE,echo = FALSE,warning=FALSE}
library(flexdashboard)
require(tidyverse)
require(forcats)
require(tidytext)
require(silgelib)
require(ggthemes)
require(hrbrthemes)
require(patchwork)
require(scales)
require(plotly)
require(d3heatmap)
require(RColorBrewer)
require(sunburstR)
firstup <- function(x) {
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
x
}
all_data_final <- read_csv("201201_all_data_final.csv")
user_ids_final <- read_csv("user_ids_final.csv")
all_data_final%>%
pivot_longer(cols = -user_name,
names_to = 'category',values_to='count')%>%
left_join(user_ids_final%>%
select(name,position),
by=c('user_name'='name'))%>%
mutate(count=ifelse(is.na(count),
0,count))->all_data_final_long
all_data_final_long%>%
mutate(category = str_replace(category,pattern = '_',replacement = ' - '))%>%
separate(category,into = c('category','B'),sep = ' - ')%>%
mutate(B = firstup(B))%>%
unite(col = category,category,B,sep = ' - ')%>%
mutate(category = firstup(category))->all_data_final_long
#can only be loaded here after all_data_final_long is done
source('helpers_new.R')
all_data_final_long%>%
mutate(count=ifelse(count>0,1,0))%>%
group_by(category)%>%
summarise(category_total=(sum(count)/n_distinct(user_name)))%>%
mutate(top_category=case_when(
category%in%ParticipationInPerson ~'ParticipationInPerson',
category%in%ParticipationByProxy ~'ParticipationByProxy',
category%in%Inflow ~'Inflow'))%>%
mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
'ParticipationByProxy','Inflow')),
category=as.factor(category))%>%
mutate(category= reorder_within(category,
category_total,top_category))->taxonomy_plots
```
Background {data-icon="fa-book-open"}
================================
[Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology](https://www.communication.aau.dk/research/Research+Projects/react/) that seeks to develop and explore the department's impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University.
By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.
This websites presents some of the project outcomes as interactive visualizations.
Taxonomy Usage {data-icon="fa-bars"}
================================
Column {.tabset}
-----------------------------------------------------------------------
### All {data-height=1200}
```{r}
taxonomy_plots%>%ggplot(mapping=aes(x=category,y=category_total,
fill=top_category))+
geom_col(aes(text=paste('Percentage:',
round(category_total*100,2))))+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_all
ggplotly(taxonomy_usage_all,tooltip = c('text'))%>%
layout(legend = list(orientation = "h",x = 0, y = -0.1))
```
### Participation in Person
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Person'))%>%
ggplot(mapping=aes(x=category,y=category_total,
fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_person
ggplotly(taxonomy_usage_person)
```
### Participation by Proxy
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Proxy'))%>%
ggplot(mapping=aes(x=category,
y=category_total,
fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_proxy
ggplotly(taxonomy_usage_proxy)
```
### Inflow
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Inflow'))%>%
ggplot(mapping=aes(x=category,y=category_total,
fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+
scale_y_continuous(labels = percent)+
scale_x_reordered()+
theme_minimal()+
labs(x='',y='Percentage of Participants',
fill='',title='')+
theme(axis.text.y = element_text(size=7))->taxonomy_usage_inflow
ggplotly(taxonomy_usage_inflow)
```
### Inputs {.sidebar}
-------------------------------------
Bla bla bla
Demographics {data-icon="fa-users"}
=====================================
Row
-------------------------------------
### Participant Positions
```{r}
user_ids_final%>%
group_by(position)%>%
count()%>%ungroup%>%
mutate(total=sum(n),percentage=n/total)%>%
ggplot(aes(x=reorder(position,percentage),y=percentage))+
geom_col(aes(text=paste('Percentage:',
round(percentage*100,2),'\nCount:',n)))+
coord_flip()+
scale_y_continuous(labels = percent)+
labs(x='',y='Percentage of Participants',
fill='',title='')+theme_minimal()->demo_position
ggplotly(demo_position,tooltip = c('text'))
```
### Testi 1
```{r}
```
Row
---------------------------------------
### Relative Contribution Per Category by Position
```{r}
all_data_final_long%>%
mutate(count=ifelse(count>0,1,0))%>%
mutate(top_category=case_when(
category%in%ParticipationInPerson ~'ParticipationInPerson',
category%in%ParticipationByProxy ~'ParticipationByProxy',
category%in%Inflow ~'Inflow'))%>%
mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
'ParticipationByProxy','Inflow')),
category=as.factor(category))%>%
group_by(position,top_category)%>%
summarise(total_count=sum(count))%>%
ggplot(aes(x=reorder(position,total_count),y=total_count,fill=top_category))+
geom_col()+coord_flip()+
scale_fill_manual(values = cols)+theme_minimal()+
labs(x='Position',
y='Total Contribution Per Top Category',fill='')->position_top_category_count
ggplotly(position_top_category_count)
```
### Testi 3
Cases {data-icon="fa-users"}
=====================================
```{r}
all_data_final_long%>%mutate(top_category=case_when(
category%in%ParticipationInPerson ~'ParticipationInPerson',
category%in%ParticipationByProxy ~'ParticipationByProxy',
category%in%Inflow ~'Inflow'))%>%
mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
'ParticipationByProxy','Inflow')))%>%
mutate(category = str_remove(category,'Inflow - '))%>%
mutate(helper = str_remove(category,' - '))%>%
mutate(category = sub(x = category,pattern = ' .*',replacement = ''))%>%
mutate(category = ifelse(category == helper,'Reference',category))%>%
mutate(category=as.factor(category))%>%
unite('sunburst_combo',c(top_category,category,helper),sep='-')%>%
mutate(sunburst_combo = str_remove_all(sunburst_combo,pattern =' '))%>%
select(user_name,V1=sunburst_combo,V2=count)->sunburst_data
tibble(
colors=c('blue','red','darkgreen',
rep('#5B5BFF',8),
rep('#B6B6FF',42),
rep('#FF5B5B',5),
rep('#FFB6B6',33),
rep('#008300',4),
rep('#C5FFC5',17)),
labels=c(c("ParticipationInPerson","ParticipationByProxy","Inflow"),
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationInPerson')%>%pull(layer2)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationInPerson')%>%pull(layer3)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationByProxy')%>%pull(layer2)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='ParticipationByProxy')%>%pull(layer3)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='Inflow')%>%pull(layer2)%>%unique,
sunburst_data%>%
separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
filter(layer1=='Inflow')%>%pull(layer3)%>%unique))->color_tibble
```
Row
-------------------------------------
### Svend Brinkman
```{r}
sunburst_data%>%
filter(user_name=='Brinkmann, Svend')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
### Rikke Magnusen
```{r}
sunburst_data%>%
filter(user_name=='Magnussen, Rikke')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
Row
-------------------------------------
### Rikke Kristine Nielsen
```{r}
sunburst_data%>%
filter(user_name=='Nielsen, Rikke Kristine')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
### Music Therapy
```{r}
sunburst_data%>%
filter(user_name=='Ridder, Hanne Mette Ochsner')%>%
#mutate(V2=ifelse(V2>0,1,0))%>%
select(-user_name)%>%
sunburst(colors = list(range=color_tibble$colors,
domain=color_tibble$labels),legend=FALSE)
```
Analysis {data-icon="fa-cog"}
================================
Column {.tabset}
-----------------------------------------------------------------------
### Heatmap {data-height=1200}
```{r}
top_5_each<-c('TeachingActivity - HigherEducation',
'FieldActivities - Meeting',
'AcademicEvent - Meeting',
'AcademicEvent - Seminar',
'AcademicEvent - Conference',
'AcademicProduct - Paper',
'AcademicProduct - Chapter',
'MediaProduct - ArticleJournalism',
'AcademicProduct - Manuscript','AcademicProduct - Abstract',
'Inflow - PopularMention','Inflow - PopularCitation',
'Request - Collaboration','Request - Advice','Request - Text')
all_data_final_long%>%filter(category%in%top_5_each)%>%
pivot_wider(names_from=category,values_from = count)%>%
select(-position)%>%column_to_rownames('user_name')->data_for_heatmap
d3heatmap(data_for_heatmap,
scale = 'column',
col = 'Blues',
na.color = 'Darkblue',
dendrogram = 'row',
k_row=4,
cexCol = 0.8,cexRow = 0.8,
height =900,width = 700,
labColSize = 200,labRowSize = 200)
```
### Activity Diversity Value
```{r}
#How diverse are participants in their activities
#i.e. among all possible
all_data_final_long%>%mutate(count = ifelse(count == 0,0,1))%>%
group_by(user_name,position)%>%
summarise(count_activities = sum(count),
total_cats=n(),
adv = count_activities/total_cats)%>%
mutate(position = firstup(position))%>%
ggplot(mapping = aes(x=position,y=adv))+
geom_violin(aes(color = position,
fill = position),alpha=0.6)+
geom_jitter(width = 0.2,
aes(color=position,fill=position,
text=paste('Participant: ',
user_name,'\nActivity Diversity Valye: ',adv)))+
theme_minimal()+
labs(y='Activity Diversity Value',
x='',fill='',color='')->adv_plot
ggplotly(adv_plot,tooltip = c('text'))
```
### And so on
### Inputs {.sidebar}
-------------------------------------
Bla bla bla